home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / C / MAIN.C < prev    next >
Encoding:
C/C++ Source or Header  |  1993-10-24  |  7.0 KB  |  227 lines
  1. /************************************************************************
  2.  *                                    *
  3.  *        PC Scheme/Geneva 4.00 Borland C code            *
  4.  *                                    *
  5.  * (c) 1985-1988 by Texas Instruments, Inc. See COPYRIGHT.TXT        *
  6.  * (c) 1992 by L. Bartholdi & M. Vuilleumier, University of Geneva    *
  7.  *                                    *
  8.  *----------------------------------------------------------------------*
  9.  *                                    *
  10.  *            The Main Scheme Routine                *
  11.  *                                    *
  12.  *----------------------------------------------------------------------*
  13.  *                                    *
  14.  * Created by: John Jensen        Date: 1985            *
  15.  * Revision history:                            *
  16.  * - 18 Jun 92:    Renaissance (Borland Compilers, ...)            *
  17.  *                                    *
  18.  *                    ``In nomine omnipotentii dei''    *
  19.  ************************************************************************/
  20.  
  21. #include     "mysignal.h"
  22. #include    <string.h>
  23. #include    <stdlib.h>
  24. #include    <stdio.h>
  25. #include    <conio.h>
  26. #include    <dos.h>
  27. #include    <dir.h>
  28. #include     "scheme.h"
  29.  
  30. static char    *spec_symbs[] = {
  31.     "SCHEME-TOP-LEVEL",         "READ",            "EOF",
  32.     "INPUT-PORT",             "OUTPUT-PORT",         "CONSOLE",
  33.         "*THE-NON-PRINTING-OBJECT*",    "USER-GLOBAL-ENVIRONMENT",
  34.         "USER-INITIAL-ENVIRONMENT",     pcsrsenv,
  35.         "*ERROR-HANDLER*",              "PCS-STATUS-WINDOW",
  36.         "PCS-KILL-ENGINE", NULL };
  37.  
  38. #ifdef VMDEBUG
  39.     #define    BETADEBUG    "/betadebug"
  40.     #define action(what)    if (vm_debug) printf(what)
  41. #else
  42.     #define    action(what)    /* what */
  43. #endif
  44.  
  45. extern unsigned paragraphnum;        /* number of paragraphs of memory available */
  46. extern unsigned _stklen = 0x4000;
  47.  
  48. #define    internimm(reg,name)    intern( reg, name, sizeof name - 1 );
  49.  
  50. void    setwindow( unsigned, unsigned, int, unsigned );
  51. void    setitup( int, char *[], unsigned & );
  52.  
  53. #pragma    argsused
  54.  
  55. int main(int argc, char *argv[])
  56. {
  57.     extern int    _argc;
  58.     RETVALUE    stat;
  59.     unsigned    errcode, textattrib;
  60.  
  61.     action("Entering MAIN\n");
  62.  
  63.     setitup( _argc, argv, textattrib );
  64.     /* use the argc value computed in startup, not the primitive C parse */
  65.  
  66.     action("\nNow starting Virtual Machine. Type ? to get help from within VM debugger\n");
  67.     do {
  68.         while( (stat = interp(&s_pc, &errcode, 0xffff)) == PROCEED );
  69. #ifdef    VMDEBUG
  70.         if( stat == SDEBUG || stat == CLOBBERED )
  71.             stat = sdebug( &errcode );
  72. #endif
  73.     } while( stat != HALT );
  74.  
  75. #ifdef VMDEBUG
  76.     #undef    action
  77.     #define action(what)    /* no more comment */
  78. #endif
  79.     setwindow( WHO_PAGE, WHO_DISP, WINDOW_ATTRIBUTES, textattrib );
  80.     return    errcode;
  81. }
  82.  
  83. /************************************************************************/
  84. /* Set-up a window port                                        */
  85. /************************************************************************/
  86. void    setwindow( unsigned page, unsigned disp, int where, unsigned what )
  87. {
  88.     REG    window( disp, ADJPAGE(page) );
  89.     REG    f1( where, ADJPAGE(SPECFIX) );
  90.     REG    f2( what,  ADJPAGE(SPECFIX) );
  91.     
  92.     action("Manipulating a window\n");
  93.  
  94.     set_window_attribute( &window, &f1, &f2 );
  95.     if( where == WINDOW_ATTRIBUTES )
  96.         clear_window( &window );
  97. }
  98.  
  99. /************************************************************************/
  100. /* Set-up all PCS stuffs                                    */
  101. /************************************************************************/
  102. unsigned    ndp[] = { 0, 87, 287, 387 };
  103.  
  104. void    setitup( int argc, char *argv[], unsigned &textattrib )
  105. {
  106.     int        i, j;
  107.     int        page_count;
  108.     REGPTR        ptr;
  109.     REG        sym_reg, f1, f2, in_ptr;
  110.     
  111. #ifdef    VMDEBUG        /* search for /BETADEBUG parameter */
  112.     for( i = 0; i < argc; i++ )
  113.         vm_debug |= ( stricmp( argv[i], BETADEBUG ) == 0 );
  114. #endif
  115.  
  116.     action("Allocating memory\n");
  117.     page_count = initmem();
  118.  
  119.     action("Initializing console: height... ");
  120.     setwindow( IN_PAGE, IN_DISP, WINDOW_NROWS, get_max_rows() );
  121.     setwindow( IN_PAGE, IN_DISP, WINDOW_NCOLS, get_max_cols() );
  122.     action("colors... ");
  123. asm {
  124.     mov    ah, 0fh            /* get mode settings */
  125.     int    10h
  126.     mov    ah, 08h            /* read character & attribute */
  127.     int    10h
  128. }
  129.     textattrib = _AH;
  130.     setwindow( IN_PAGE, IN_DISP, WINDOW_ATTRIBUTES, textattrib );
  131.  
  132. #ifdef VMDEBUG                /* now use zprintf instead of printf */
  133.     #undef    action
  134.     #define action(what)    if (vm_debug) zprintf(what);
  135. #endif
  136.                     /* Print Welcome to Scheme */
  137.  
  138.     ssetadr( ADJPAGE(OUT_PAGE), OUT_DISP );
  139.     outtext( VERSIONSTR, sizeof VERSIONSTR );
  140.     outtext( TEXASRIGHTS, sizeof TEXASRIGHTS );
  141.     outtext( GENEVARIGHTS, sizeof GENEVARIGHTS );
  142.     outtext( RESTRICTIONS, sizeof RESTRICTIONS );
  143.  
  144.     if (page_count <= 10)
  145.         print_and_exit("[VM FATAL ERROR] Unable to allocate memory for PC Scheme\n");
  146.     else {
  147.         pagelink[nextpage - 1] = END_LIST;
  148.         if (vm_debug)
  149.             zprintf("0x%x total main paragraphs, %dK allocated in 0x%x pages\n", 
  150.                 paragraphnum, (unsigned short) (freesp() >> 10), page_count );
  151.     }
  152.  
  153.     setwindow( WHO_PAGE, WHO_DISP, WINDOW_ULROW, get_max_rows() );
  154.     setwindow( WHO_PAGE, WHO_DISP, WINDOW_NCOLS, get_max_cols() );
  155.     setwindow( WHO_PAGE, WHO_DISP, WINDOW_ATTRIBUTES, 0x70 ); /* reverse attribute */
  156.     gc_off();
  157.  
  158.     action("Binding PCS-INITIAL-ARGUMENTS\n");
  159.     internimm( &sym_reg, "PCS-INITIAL-ARGUMENTS");
  160.     regs[1] = nil_reg;
  161.     for( i = argc-1; i >= 1; i-- )
  162.     {
  163.         alloc_string( regs+2, argv[i] );
  164.         cons( regs+1, regs+2, regs+1 );
  165.     }
  166.     if( argc > 1 )
  167.         free( argv[1] );    /* the argument block belongs to the first */
  168.     sym_bind( &sym_reg, regs+1, &gnv_reg );
  169.  
  170.     action("Parsing .APP files, setting system path\n");
  171.     {
  172.         static char    *app_file = "bootstrp.app";
  173.         char        drive[MAXDRIVE];
  174.         char        dir[MAXDIR];
  175.         char        file[MAXFILE];
  176.         char        ext[MAXEXT];
  177.  
  178.         if( argc > 1 && argv[1][0] == '&')
  179.             app_file = argv[1]+1;
  180.  
  181.         if( !( fnsplit(app_file, drive, dir, file, ext) & (DRIVE | DIRECTORY) ) ) {
  182.             fnsplit( argv[0], drive, dir, NULL, NULL );
  183.             app_file = (char *) malloc( strlen(drive) + strlen(dir) +
  184.                            strlen(file) + strlen(ext) + 1 );
  185.             fnmerge( app_file, drive, dir, file, ext );
  186.         }
  187.         alloc_string( regs+1, app_file );
  188.         fnsplit( app_file, drive, dir, NULL, NULL );
  189.         fnmerge( app_file, drive, dir, NULL, NULL );
  190.         internimm( &sym_reg, "PCS-SYSDIR");
  191.         alloc_string(&tm2_reg, app_file);
  192.         sym_bind(&sym_reg, &tm2_reg, &gnv_reg);
  193.                     /* put the compiler name into VM register 1 */
  194.         rlsstr(app_file);
  195.     }
  196.  
  197.     if (vm_debug)            /* put VM debug flag into VM register 2 */
  198.         regs[2].page = ADJPAGE(SPECFIX), regs[2].disp = 0;
  199.     else
  200.         regs[2] = nil_reg;
  201.  
  202.     action("Defining QUOTE... ");
  203.     internimm( &tmp_reg, "QUOTE");
  204.     quote_reg = tmp_reg;
  205.  
  206.     action("and other special symbols\n");
  207.     for (i = 0, j = 6; spec_symbs[i]; i++, j += sizeof(POINTER))
  208.     {
  209.         intern(&tmp_reg, spec_symbs[i], strlen(spec_symbs[i]));
  210.         put_ptr(SPECCODE, j, tmp_reg.page, tmp_reg.disp);
  211.     }
  212.     internimm( &console_reg, "CONSOLE");
  213.  
  214.     action("Interning PCS-MACHINE-TYPE\n");
  215.     internimm( &sym_reg, "PCS-MACHINE-TYPE");
  216.     sym_bind( &sym_reg, &nil_reg, &gnv_reg );
  217.  
  218.     action("Setting up interrupts ");
  219.     fix_intr();    /* "Fixes" the keyboard DSR to have SHIFT-BRK cause the */
  220.             /* debugger to "kick-in" on the next VM instruction    */
  221.             /* "Fixes" 24H int DOS Fatal error too            */
  222.             /* The keyboard is restored in SC.ASM            */
  223.     action("and floating point exceptions\n");
  224.     signal( SIGFPE, fperror );
  225. }
  226.  
  227.